home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 015 / softad.arc / USASCII.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-07  |  5.9 KB  |  215 lines
  1. {$G2048,P2048,D-}
  2. program    widths;
  3. {-----------------------------------------------------------------------}
  4. {                                                                       }
  5. {    Reduce  Roman-8 Font Files to USASCII Font Files                   }
  6. {                                                                       }
  7. {         usascii   SOURCE  DESTINATION                                 }
  8. {                   (using DOS redirection facilities)                  }
  9. {                                                                       }
  10. {-----------------------------------------------------------------------}
  11.  
  12. {---------------  Font Descriptor  -------------------------------------}
  13. type
  14.  
  15.    FontMap = record
  16.          {+ 0}   Res0:       integer;
  17.          {+ 2}   Res1:       byte;
  18.          {+ 3}   FontType:   byte;
  19.          {+ 4}   Res2:       integer;
  20.          {+ 6}   Baseline:   integer;
  21.          {+ 8}   CellWidth:  integer;
  22.          {+10}   CellHeight: integer;
  23.          {+12}   Orientation: byte;
  24.          {+13}   FixedProp:  byte;
  25.          {+14}   SymbolSet:  integer;
  26.          {+16}   Pitch:      integer;
  27.          {+18}   Height:     integer;
  28.          {+20}   Res3:       integer;
  29.          {+22}   Res4:       byte;
  30.          {+23}   Style:      byte;
  31.          {+24}   StrokeWeight: byte;
  32.          {+25}   Typeface:   byte;
  33.               end;
  34.  
  35. {---------------  Character Descriptor  --------------------------------}
  36.    CharMap = record
  37.          {+ 0}   Res0:       integer;
  38.          {+ 2}   Res1:       integer;
  39.          {+ 4}   Orientation: char;
  40.          {+ 5}   Res2:       byte;
  41.          {+ 6}   LeftOffset: integer;
  42.          {+ 8}   TopOffset:  integer;
  43.          {+10}   CharWidth:  integer;
  44.          {+12}   CharHeight: integer;
  45.          {+14}   DeltaX:     integer;
  46.               end;
  47.  
  48.    HpFont = record
  49.               case Boolean of
  50.                  True:  (Tab: array[0..25] of Char);
  51.                  False: (Def: FontMap);
  52.  
  53.               end;
  54.  
  55.    HpChar = record
  56.               case Boolean of
  57.                  True:  (Tab: array[0..15] of Char);
  58.                  False: (Def: CharMap);
  59.               end;
  60.  
  61. Var
  62.  
  63.    CC, i, j    :  integer;
  64.    FontDesc    :  HpFont;
  65.    CharDesc    :  HpChar;
  66.    Nextc       :  char;
  67.    Char1, Char2, Char3 : char;
  68.    NumStr      :  string[5];
  69.    Skip        :  integer;
  70.    CharCode    :  integer;
  71.  
  72. label
  73.  
  74.    quit;
  75.  
  76.  
  77. begin
  78.  
  79.    WriteLn(Con, 'USASCII v1.01');
  80.    WriteLn(Con, 'Denis DeLaRoca, 1987');
  81.  
  82. {------  Make Sure File starts with Font Desc: "^[)s"  ----------------}
  83.  
  84.    read(Char1, Char2, Char3);
  85.    if (Char1 <> #$1b) or (Char2 <> ')') or (Char3 <> 's')
  86.       then begin
  87.               writeln('*** Missing Font Descriptor');
  88.               halt(1);
  89.            end;
  90.  
  91. {------  Extract Length of Descriptor + Data   ------------------------}
  92.  
  93.    NumStr := '';
  94.    read(Nextc);
  95.    while nextc <> 'W' do
  96.    begin
  97.       NumStr := NumStr + nextc;
  98.       read(nextc);
  99.    end;
  100.    Val(NumStr, Skip, CC);
  101.    if CC <> 0
  102.       then begin
  103.               writeln('*** Bad Font Descriptor Length');
  104.               halt(2);
  105.            end;
  106.  
  107. {------  Read Font Descriptor Header and Output Some Parms   ----------}
  108.  
  109.    for i := 0 to 25
  110.       do read(FontDesc.Tab[i]);
  111.    with FontDesc, Def do
  112.    begin
  113.       FontType := 0;                   { Force FontType to "7-bit"     }
  114.       SymbolSet := 21;                 { Force Symbol Set to "21"      }
  115.       SymbolSet := Swap(SymbolSet);
  116.    end;
  117.  
  118. {------  Write Font Descriptor to Output File  ------------------------}
  119.  
  120.    Write(Char1, Char2, Char3, NumStr, 'W');
  121.    for i := 0 to 25
  122.       do Write(FontDesc.Tab[i]);
  123.  
  124. {------  Transfer Rest of Font Descriptor Data  ------------------------}
  125.  
  126.    Skip := Skip - 26;
  127.    for i := 1 to skip do
  128.    begin
  129.       Read(Nextc);
  130.       Write(Nextc);
  131.    end;
  132.  
  133. {------  Now Start Main Loop, Copy Char Id's and Descriptors  ---------}
  134.  
  135.    repeat
  136.       repeat
  137.          read(Char1);
  138.       until (Char1 = #$1b);
  139.       read(Char2, Char3);
  140.    until (Char2 = '*') and (Char3 = 'c');
  141.  
  142. {------  Validate Char Code Descriptor --------------------------------}
  143.  
  144.    while ((not EOF) and (Char1 <> #$00)) do
  145.    begin
  146.       if (Char1 <> #$1b) or (Char2 <> '*') or (Char3 <> 'c')
  147.          then begin
  148.                  writeln('*** Bad Char Code Desc');
  149.                  halt(3);
  150.               end;
  151.  
  152. {------  Extract Char Code Value  --------------------------------------}
  153.  
  154.       NumStr := '';
  155.       Read(Nextc);
  156.       while nextc <> 'E' do
  157.       begin
  158.          NumStr := NumStr + Nextc;
  159.          Read(Nextc);
  160.       end;
  161.       Val(NumStr, CharCode, CC);
  162.  
  163. {------  Find End of USASCII Font, Write Char-id Desc  -----------------}
  164.  
  165.       If CharCode >= 128
  166.          then goto quit;
  167.       Write(Char1, Char2, Char3, NumStr, 'E');
  168.  
  169. {------  Validate Char Font Descriptor  -------------------------------}
  170.  
  171.       Read(Char1,Char2, Char3);
  172.       if (Char1 <> #$1b) or (Char2 <> '(') or (Char3 <> 's')
  173.          then begin
  174.                  writeln('*** Bad Char Descriptor');
  175.                  halt(4);
  176.                end;
  177.  
  178. {------  Extract Length of Descriptor + Data  -------------------------}
  179.  
  180.       NumStr := '';
  181.       Read(Nextc);
  182.       while nextc <> 'W' do
  183.       begin
  184.          NumStr := NumStr + Nextc;
  185.          Read(Nextc);
  186.       end;
  187.       Val(NumStr, Skip, CC);
  188.  
  189. {------  Duplicate Char Font Descriptor  -------------------------------}
  190.  
  191.       Write(Char1, Char2, Char3, NumStr, 'W');
  192.       for i := 0 to 15 do
  193.       begin
  194.          Read(Nextc);
  195.          Write(Nextc);
  196.       end;
  197.  
  198. {------  Duplicate Char Font Data  -------------------------------------}
  199.  
  200.       Skip := Skip - 16;
  201.       for i := 1 to Skip do
  202.       begin
  203.          Read(Nextc);
  204.          Write(Nextc);
  205.       end;
  206.  
  207. {------  Try to Fetch Next Char Code Descriptor  ----------------------}
  208.  
  209.       Read(Char1, Char2, Char3);
  210.    end;
  211.  
  212. quit:
  213.  
  214. end.
  215.